home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 40
/
Aminet 40 (2000)(Schatztruhe)[!][Dec 2000].iso
/
Aminet
/
misc
/
emu
/
ATUtilities.lha
/
ATUtilities
/
turbo.mod
< prev
next >
Wrap
Text File
|
2000-09-26
|
54KB
|
2,132 lines
(*$S- *)
(* R-, T-, A- *)
MODULE Turbo;
FROM SYSTEM IMPORT BYTE,ADR,ADDRESS,ASSEMBLER,OFFSET,SEGMENT,OFS,SEG;
FROM System IMPORT AX,BX,CX,DX,ES,DI,DS,SI,BP,Trap,XTrap,SetVector,GetVector,
ResetVector,Move,Terminate,FLAGS,zeroFlag;
FROM Strings IMPORT Length,Assign,Insert,Delete;
FROM Storage IMPORT ALLOCATE,DEALLOCATE;
FROM TimeDate IMPORT Time,GetTime;
FROM NumberConversion IMPORT NumToString;
FROM Loader IMPORT Execute;
FROM InOut IMPORT WriteString,WriteLn;
FROM TurboSys IMPORT STRING,tdos,
interruptVector,memoryVector,
WindowPtr,MenuPtr,SysMsgPtr,TurboDOSPtr,GadgetPtr,
Window,Menu,SysMsg,TurboDOS,Gadget,
boolGadget,strGadget,intGadget,toggleGadget,propGadget,
WindowFlags,WindowFlagSet,
MouseButtons,MouseButtonSet,
SysMsgClasses,SysMsgClassSet,
ItemFlags,ItemFlagSet,
stdItem,bar,check;
IMPORT TurboSys;
FROM Break IMPORT InstallBreakHandler,UninstallBreakHandler,EnableBreak;
CONST
timerVector = 01CH;
version = 0005;
welcome = "Willkommen zu TurboDOS Version 0.5!";
patternScreenBackgrnd = 176;
patternWindowBackgrnd = 32;
colorWindowBackgrnd = (3*16);
colorScreenBackgrnd = 14;
colorAWindowBorders = 6+(3*16);
colorIWindowBorders = 9+(3*16);
colorWindowAPen = 14;
colorWindowBPen = 3;
colorGadget = 12+(3*16);
colorGadgetSelected = 14+(3*16);
colorGadgetDisabled = 8+(3*16);
colorHelpBar = 14+(3*16);
colorMove = 14+(15*16);
colorMenuBar = 14+(3*16);
colorMenuEnabled = 14+(3*16);
colorMenuDisabled = 12+(3*16);
colorMenuSelected = 9+(15*16);
colorMenuBorder = 7+(3*16);
videoWidth = 80;
videoHeight = 25;
videoMode = 03H;
closeGadget = 100;
depthGadget = 101;
sizeGadget = 102;
noMemory = 100;
noMouse = 101;
VAR a,b,c,d : CARDINAL;
w1,w2,w3,w4,w5,w6 : WindowPtr;
t1,t2,t3,t4,t5,t6 : ARRAY [0..79] OF CHAR;
g1,g2,g3,g4,g5,g6,g7,g8,g9 : Gadget;
m1,m2 : Menu;
adr : ADDRESS;
oldColors : ARRAY [0..(16*3)] OF BYTE;
oldVector1,
oldVector2,
oldVector3 : ADDRESS;
timerCounter : CARDINAL;
timerUpdate : BOOLEAN;
PROCEDURE F1;
BEGIN
timerCounter := timerCounter + 1;
IF (timerCounter>10) THEN
timerCounter := 0;
timerUpdate := TRUE;
END (* IF *);
END F1;
PROCEDURE TimerInterrupt;
BEGIN
ASM
CALL F1
IRET
END (* ASM *);
END TimerInterrupt;
PROCEDURE RestoreCursor;
BEGIN
AX := 0200H;
BX := 0;
DX := tdos^.cursorPos;
Trap(010H);
END RestoreCursor;
PROCEDURE SetCursor(a,b : CARDINAL);
BEGIN
tdos^.cursorPos := (b*256)+a;
AX := 0200H;
BX := 0;
DX := tdos^.cursorPos;
Trap(010H);
END SetCursor;
PROCEDURE CopyVideo2Buffer(buffer : ADDRESS;
x,y,w,h : CARDINAL);
VAR video : ADDRESS;
j : CARDINAL;
bpr : CARDINAL;
BEGIN
video.SEG := 0B800H;
video.OFS := y*tdos^.videoBPR+(x*2);
bpr := w*2;
FOR j := y TO y+h DO
Move(video,buffer,bpr);
buffer.OFS := buffer.OFS + bpr;
video.OFS := video.OFS + 160;
END (* FOR *);
END CopyVideo2Buffer;
PROCEDURE CopyBuffer2Video(buffer : ADDRESS;
x,y,w,h : CARDINAL);
VAR video : ADDRESS;
j : CARDINAL;
bpr : CARDINAL;
BEGIN
video.SEG := 0B800H;
video.OFS := y*tdos^.videoBPR+(x*2);
bpr := w*2;
FOR j := y TO y+h DO
Move(buffer,video,bpr);
buffer.OFS := buffer.OFS + bpr;
video.OFS := video.OFS + 160;
END (* FOR *);
END CopyBuffer2Video;
PROCEDURE WriteText(attribut : CARDINAL;
x,y : CARDINAL;
text : STRING);
VAR l,o,s,to,ts : CARDINAL;
BEGIN
l := Length(text^);
IF (l=0) THEN RETURN; END;
s := 0B800H;
o := (y*tdos^.videoBPR)+(x*2);
ts := text.SEG;
to := text.OFS;
ASM
MOV ES,s
MOV DI,o
MOV DS,ts
MOV SI,to
MOV CX,l
MOV AX,attribut
Schleife:
MOV AH,DS:[SI]
MOV ES:[DI],AH
MOV ES:[DI+1],AL
ADD DI,2
ADD SI,1
SUB CX,1
CMP CX,0
JNE Schleife
END (* ASM *);
RestoreCursor;
END WriteText;
PROCEDURE Fill(attribut,
x,y,w,h : CARDINAL;
zeichen : CARDINAL);
VAR i : CARDINAL;
BEGIN
FOR i := y TO y+h DO
AX := 0200H;
BX := 0;
DX := (i*256)+x;
Trap(010H);
AX := 0900H+zeichen;
BX := attribut;
CX := w;
Trap(010H);
END (* FOR *);
RestoreCursor;
END Fill;
PROCEDURE DrawX(attribut,
x,y,l,
zeichen : CARDINAL);
BEGIN
AX := 0200H;
BX := 0;
DX := (y*256)+x;
Trap(010H);
AX := 0900H+zeichen;
BX := attribut;
CX := l;
Trap(010H);
RestoreCursor;
END DrawX;
PROCEDURE DrawY(attribut,
x,y,l,
zeichen : CARDINAL);
VAR j : CARDINAL;
BEGIN
FOR j := y TO y+l DO
AX := 0200H;
BX := 0;
DX := (j*256)+x;
Trap(010H);
AX := 0900H+zeichen;
BX := attribut;
CX := 1;
Trap(010H);
END (* FOR *);
RestoreCursor;
END DrawY;
PROCEDURE DrawWindowBorder(win : WindowPtr;
active : BOOLEAN);
VAR tex : ARRAY [0..5] OF CHAR;
j,c : CARDINAL;
BEGIN
j := Length(win^.title);
IF (active=TRUE) THEN c := tdos^.colorAWindowBorders; ELSE c := tdos^.colorIWindowBorders; END;
DrawX(c,win^.leftEdge,win^.topEdge+win^.height,win^.width,205);
DrawX(c,win^.leftEdge,win^.topEdge+win^.height,1,200);
DrawX(c,win^.leftEdge+j,win^.topEdge,win^.width-j,205);
DrawX(c,win^.leftEdge,win^.topEdge,1,201);
DrawX(c,win^.leftEdge+4,win^.topEdge,1,205);
IF (windowClose IN win^.flags) THEN
tex[0] := "[";
tex[1] := 11C;
tex[2] := "]";
tex[3] := 0C;
WriteText(tdos^.colorGadget,win^.leftEdge+1,win^.topEdge,ADR(tex));
END (* IF *);
IF (windowDepth IN win^.flags) THEN
tex[0] := "[";
tex[1] := 37C;
tex[2] := "]";
tex[3] := 0C;
WriteText(tdos^.colorGadget,win^.leftEdge+win^.width-4,win^.topEdge,ADR(tex));
END (* IF *);
IF (j<win^.width+10) THEN
WriteText(c,win^.leftEdge+5,win^.topEdge,ADR(win^.title));
END (* IF *);
DrawY(c,win^.leftEdge,win^.topEdge+1,win^.height-2,186);
DrawY(c,win^.leftEdge+win^.width-1,win^.topEdge+1,win^.height-2,186);
DrawX(c,win^.leftEdge+win^.width-1,win^.topEdge,1,187);
IF NOT (windowSizing IN win^.flags) THEN
DrawX(c,win^.leftEdge+win^.width-1,win^.topEdge+win^.height,1,188);
ELSE
DrawX(tdos^.colorGadget,win^.leftEdge+win^.width-1,win^.topEdge+win^.height,1,29);
END (* IF *);
RestoreCursor;
END DrawWindowBorder;
PROCEDURE InactivateWindow(win : WindowPtr);
BEGIN
DrawWindowBorder(win,FALSE);
CopyVideo2Buffer(win^.buffer,win^.leftEdge,win^.topEdge,win^.width,win^.height);
END InactivateWindow;
PROCEDURE ShowMenuStrip(win : WindowPtr);
VAR menu : MenuPtr;
BEGIN
DrawX(tdos^.colorMenuBar,0,0,tdos^.videoWidth,32);
menu := win^.firstMenu;
WHILE (menu # NIL) DO
WriteText(tdos^.colorMenuBar,menu^.leftEdge,0,ADR(menu^.title));
menu := menu^.nextMenu;
END (* WHILE *);
END ShowMenuStrip;
PROCEDURE ShowMenu(menu : MenuPtr);
BEGIN
MouseOff;
tdos^.firstWindow^.firstMenu := menu;
ShowMenuStrip(tdos^.firstWindow);
RestoreCursor;
MouseOn;
END ShowMenu;
PROCEDURE ActWin(win : WindowPtr);
BEGIN
CopyBuffer2Video(win^.buffer,win^.leftEdge,win^.topEdge,win^.width,win^.height);
DrawWindowBorder(win,TRUE);
tdos^.cursorPos := win^.cursorPos+(win^.topEdge*256)+win^.leftEdge;
ShowMenuStrip(win);
RestoreCursor;
END ActWin;
PROCEDURE ActivateWindow(win : WindowPtr);
VAR w2 : WindowPtr;
BEGIN
IF (tdos^.firstWindow # win) THEN
MouseOff;
InactivateWindow(tdos^.firstWindow);
w2 := tdos^.firstWindow;
WHILE (w2^.nextWindow # win) DO
w2 := w2^.nextWindow;
END (* WHILE *);
w2^.nextWindow := win^.nextWindow;
win^.nextWindow := tdos^.firstWindow;
tdos^.firstWindow := win;
ActWin(win);
MouseOn;
END (* IF *);
END ActivateWindow;
PROCEDURE OpenWindow(win : WindowPtr);
VAR j : CARDINAL;
BEGIN
j := Length(win^.title)+3;
MouseOff;
IF (tdos^.firstWindow # NIL) THEN
InactivateWindow(tdos^.firstWindow);
END (* IF *);
win^.topEdge := win^.topEdge + 1;
win^.height := win^.height + 1;
IF ((win^.leftEdge+win^.width)>tdos^.videoWidth) THEN
win^.width := tdos^.videoWidth-win^.leftEdge;
END (* IF *);
IF ((win^.topEdge+win^.height)>tdos^.videoMaxY) THEN
win^.height := tdos^.videoMaxY-win^.topEdge-1;
END (* IF *);
IF (requester IN win^.flags) THEN
CopyVideo2Buffer(win^.buffer,win^.leftEdge,win^.topEdge,win^.width,win^.height);
MouseLimits(win^.leftEdge,win^.topEdge,win^.leftEdge+win^.width-1,win^.topEdge+win^.height);
END (* IF *);
Fill(tdos^.colorWindowBackgrnd,
win^.leftEdge,win^.topEdge,win^.width,win^.height,
tdos^.patternWindowBackgrnd);
win^.nextWindow := tdos^.firstWindow;
DrawWindowBorder(win,TRUE);
tdos^.firstWindow := win;
win^.frontPen := tdos^.colorWindowAPen;
win^.backPen := tdos^.colorWindowBPen;
win^.cursorPos := 05050H;
win^.firstGadget := NIL;
win^.firstMenu := NIL;
win^.maxWindow := FALSE;
IF (windowClose IN win^.flags) THEN
win^.sysGadgets[0].nextGadget := NIL;
win^.sysGadgets[0].leftEdge := 1;
win^.sysGadgets[0].topEdge := 0;
win^.sysGadgets[0].width := 2;
win^.sysGadgets[0].height := 1;
win^.sysGadgets[0].text[0] := "[";
win^.sysGadgets[0].text[1] := 11C;
win^.sysGadgets[0].text[2] := "]";
win^.sysGadgets[0].text[3] := 0C;
win^.sysGadgets[0].type := closeGadget;
win^.sysGadgets[0].enabled := TRUE;
IF (requester IN win^.flags) THEN
win^.sysGadgets[0].help := "Requester schließen...";
ELSE
win^.sysGadgets[0].help := "Fenster schließen...";
END (* IF *);
ShowGadget(ADR(win^.sysGadgets[0]));
j := j + 3;
END (* IF *);
IF NOT (requester IN win^.flags) THEN
IF (windowDepth IN win^.flags) THEN
win^.sysGadgets[1].nextGadget := NIL;
win^.sysGadgets[1].leftEdge := win^.width-4;
win^.sysGadgets[1].topEdge := 0;
win^.sysGadgets[1].width := 2;
win^.sysGadgets[1].height := 1;
win^.sysGadgets[1].text[0] := "[";
win^.sysGadgets[1].text[1] := 37C;
win^.sysGadgets[1].text[2] := "]";
win^.sysGadgets[1].text[3] := 0C;
win^.sysGadgets[1].type := depthGadget;
win^.sysGadgets[1].enabled := TRUE;
win^.sysGadgets[1].help := "Fenster in den Hintergrund bringen...";
ShowGadget(ADR(win^.sysGadgets[1]));
j := j + 3;
END (* IF *);
IF (windowSizing IN win^.flags) THEN
win^.sysGadgets[2].nextGadget := NIL;
win^.sysGadgets[2].leftEdge := win^.width-1;
win^.sysGadgets[2].topEdge := win^.height;
win^.sysGadgets[2].width := 1;
win^.sysGadgets[2].height := 1;
win^.sysGadgets[2].text[0] := 35C;
win^.sysGadgets[2].text[1] := 0C;
win^.sysGadgets[2].type := sizeGadget;
win^.sysGadgets[2].enabled := TRUE;
win^.sysGadgets[2].help := "";
ShowGadget(ADR(win^.sysGadgets[2]));
END (* IF *);
END (* IF *);
IF (win^.minWidth<j) THEN
win^.minWidth := j;
END (* IF *);
ShowMenuStrip(win);
tdos^.cursorPos := 05050H;
RestoreCursor;
MouseOn;
END OpenWindow;
PROCEDURE GetMouseData;
VAR x,y : CARDINAL;
b : MouseButtonSet;
BEGIN
IF (timerUpdate=TRUE) THEN
timerUpdate := FALSE;
ShowClock;
END (* IF *);
ASM
MOV AX,3
INT 033H
MOV x,CX
MOV y,DX
MOV b,BX
END (* ASM *);
tdos^.mouseX := x DIV 8;
tdos^.mouseY := y DIV 8;
tdos^.mouseButtons := b;
END GetMouseData;
PROCEDURE MouseReset;
BEGIN
AX := 0;
Trap(033H);
END MouseReset;
PROCEDURE MouseOff;
BEGIN
DEC(tdos^.mouseLock);
IF (tdos^.mouseLock=0) THEN
AX := 2;
Trap(033H);
END (* IF *);
END MouseOff;
PROCEDURE MouseOn;
BEGIN
INC(tdos^.mouseLock);
IF (tdos^.mouseLock=1) THEN
AX := 1;
Trap(033H);
END (* IF *);
END MouseOn;
PROCEDURE MouseLimits(x1,y1,x2,y2 : CARDINAL);
BEGIN
AX := 7;
CX := x1*8;
DX := x2*8;
Trap(033H);
AX := 8;
CX := y1*8;
DX := y2*8;
Trap(033H);
END MouseLimits;
PROCEDURE xMove(x,y : CARDINAL);
BEGIN
MouseOff;
SetCursor(x,y);
MouseOn;
tdos^.firstWindow^.cursorPos := tdos^.cursorPos;
END xMove;
PROCEDURE SetAPen(farbe : CARDINAL);
BEGIN
tdos^.firstWindow^.frontPen := farbe;
END SetAPen;
PROCEDURE SetBPen(farbe : CARDINAL);
BEGIN
tdos^.firstWindow^.backPen := farbe;
END SetBPen;
PROCEDURE Text(text : STRING);
VAR p,attribut,l : CARDINAL;
win : WindowPtr;
BEGIN
win := tdos^.firstWindow;
p := win^.cursorPos+(win^.topEdge*256)+win^.leftEdge;
l := Length(text^);
tdos^.cursorPos := p + l;
win^.cursorPos := win^.cursorPos + l;
attribut := win^.frontPen + (win^.backPen*16);
MouseOff;
WriteText(attribut,p MOD 256,p DIV 256,text);
MouseOn;
END Text;
PROCEDURE CenterText(y : CARDINAL;
text : STRING);
VAR win : WindowPtr;
x,l : CARDINAL;
BEGIN
win := tdos^.firstWindow;
l := Length(text^);
x := ((win^.width-l) DIV 2)+win^.leftEdge;
WriteText(win^.frontPen+(win^.backPen*16),x,y+win^.topEdge,text);
END CenterText;
PROCEDURE RestoreWindows(win : WindowPtr);
BEGIN
IF (win^.nextWindow # NIL) THEN
RestoreWindows(win^.nextWindow);
END (* IF *);
CopyBuffer2Video(win^.buffer,win^.leftEdge,win^.topEdge,win^.width,win^.height);
END RestoreWindows;
PROCEDURE CloseWindow;
VAR win : WindowPtr;
BEGIN
win := tdos^.firstWindow;
IF (win # NIL) THEN
MouseOff;
tdos^.firstWindow := win^.nextWindow;
IF NOT (requester IN win^.flags) THEN
Fill(tdos^.colorScreenBackgrnd,win^.leftEdge,win^.topEdge,win^.width,win^.height,tdos^.patternScreenBackgrnd);
RestoreWindows(tdos^.firstWindow);
ELSE
CopyBuffer2Video(win^.buffer,win^.leftEdge,win^.topEdge,win^.width,win^.height);
MouseLimits(0,0,tdos^.videoMaxX,tdos^.videoMaxY-1);
END (* IF *);
IF (win^.nextWindow # NIL) THEN
ActWin(win^.nextWindow);
END (* IF *);
RestoreCursor;
MouseOn;
END (* IF *);
END CloseWindow;
PROCEDURE KeyboardReset;
VAR bool : BOOLEAN;
BEGIN
bool := FALSE;
REPEAT
AX := 0100H;
Trap(016H);
IF NOT (zeroFlag IN FLAGS) THEN
AX := 0;
Trap(016H);
ELSE
bool := TRUE;
END (* IF *);
UNTIL (bool=TRUE);
END KeyboardReset;
PROCEDURE StrText(farbe,
x,y,w : CARDINAL;
buffer : STRING);
VAR j : CARDINAL;
BEGIN
j := Length(buffer^);
DrawX(farbe,x,y,w-2,250);
WriteText(farbe,x,y,buffer);
END StrText;
PROCEDURE StrGadgetHandler(gad : GadgetPtr);
VAR win : WindowPtr;
cursor,
x,x2,
y,c,l,
a,b : CARDINAL;
ch : CHAR;
array : ARRAY [0..1] OF CHAR;
PROCEDURE GetChr(VAR a,b : CARDINAL;
VAR c : CHAR);
VAR a1,b1 : CARDINAL;
c1 : CHAR;
BEGIN
GetMouseData;
IF ((left IN tdos^.mouseButtons)) THEN
c := 15C;
a := 0;
b := 0;
ELSE
AX := 0100H;
Trap(016H);
IF NOT(zeroFlag IN FLAGS) THEN
ASM
MOV AH,0
INT 016H
MOV BL,AL
XOR BH,BH
MOV a1,BX
MOV BL,AH
XOR BH,BH
MOV b1,BX
XOR AH,AH
MOV c1,AL
END (* ASM *);
a := a1; b := b1; c := c1;
ELSE
a := 0;
b := 0;
END (* IF *);
END (* IF *);
END GetChr;
BEGIN
cursor := tdos^.cursorPos;
win := tdos^.firstWindow;
x := win^.leftEdge+gad^.leftEdge+1;
x2 := gad^.width-2;
y := win^.topEdge+gad^.topEdge;
l := Length(gad^.buffer^);
IF NOT (tdos^.mouseX=win^.leftEdge+gad^.leftEdge) THEN
c := tdos^.mouseX-win^.leftEdge-gad^.leftEdge-1;
IF (c>l) THEN
c := l;
END (* IF *);
ELSE
c := 0;
END (* IF *);
KeyboardReset;
MouseOff;
StrText(tdos^.colorGadgetSelected,x,y,gad^.width,gad^.buffer);
SetCursor(x+c,y);
MouseOn;
array[1] := 0C;
REPEAT
GetChr(a,b,ch);
IF NOT (a=0) THEN
IF (a>30) THEN
IF (l<x2) THEN
array[0] := ch;
Insert(array,gad^.buffer^,c);
c := c + 1;
l := l + 1;
END (* IF *);
MouseOff;
StrText(tdos^.colorGadgetSelected,x,y,gad^.width,gad^.buffer);
SetCursor(x+c,y);
MouseOn;
ELSIF (b=14) THEN
IF (c>0) THEN
Delete(gad^.buffer^,c-1,1);
c := c - 1;
l := l - 1;
MouseOff;
StrText(tdos^.colorGadgetSelected,x,y,gad^.width,gad^.buffer);
SetCursor(x+c,y);
MouseOn;
END (* IF *);
END (* IF *);
ELSE
CASE b OF
75:
IF (c>0) THEN
c := c - 1;
SetCursor(x+c,y);
END (* IF *);|
77:
IF (c<l) THEN
c := c + 1;
SetCursor(x+c,y);
END (* IF *);|
83:
IF (c<l) THEN
Delete(gad^.buffer^,c,1);
l := l - 1;
MouseOff;
StrText(tdos^.colorGadgetSelected,x,y,gad^.width,gad^.buffer);
SetCursor(x+c,y);
MouseOn;
END (* IF *);
END (* CASE *);
END (* IF *);
UNTIL (ch=15C);
MouseOff;
StrText(tdos^.colorGadget,x,y,gad^.width,gad^.buffer);
tdos^.cursorPos := cursor;
RestoreCursor;
MouseOn;
END StrGadgetHandler;
PROCEDURE RedrawGadget(gad : GadgetPtr);
VAR win : WindowPtr;
j,l : CARDINAL;
BEGIN
IF (gad # NIL) THEN
MouseOff;
win := tdos^.firstWindow;
REPEAT
IF (gad^.enabled=TRUE) THEN
j := tdos^.colorGadget;
ELSE
j := tdos^.colorGadgetDisabled;
END (* IF *);
IF ((gad^.type=strGadget) OR (gad^.type=intGadget)) THEN
DrawX(j,win^.leftEdge+gad^.leftEdge,win^.topEdge+gad^.topEdge,1,91);
StrText(j,win^.leftEdge+gad^.leftEdge+1,win^.topEdge+gad^.topEdge,gad^.width,gad^.buffer);
DrawX(j,win^.leftEdge+gad^.leftEdge+gad^.width-1,win^.topEdge+gad^.topEdge,1,93);
ELSIF (gad^.type=propGadget) THEN
gad^.propButton := 0FFFFH;
DrawProp(gad,j);
ELSE
IF (gad^.type=toggleGadget) THEN
IF (gad^.selected=TRUE) THEN
gad^.text := "[x]";
ELSE
gad^.text := "[ ]";
END (* IF *);
END (* IF *);
l := Length(gad^.text);
IF (gad^.width=0) THEN
gad^.width := l-1;
END (* IF *);
WriteText(j,win^.leftEdge+gad^.leftEdge,win^.topEdge+gad^.topEdge,ADR(gad^.text));
IF ((gad^.width+1)>l) THEN
DrawX(j,win^.leftEdge+gad^.leftEdge+gad^.width,win^.topEdge+gad^.topEdge,(gad^.width+1)-l,32);
END (* IF *);
END (* IF *);
IF (windowSizing IN win^.flags) THEN
IF NOT ((gad^.type=sizeGadget) OR (gad^.type=depthGadget)) THEN
IF ((gad^.leftEdge+gad^.width+1)>win^.minWidth) THEN
win^.minWidth := gad^.leftEdge+gad^.width+1;
END (* IF *);
IF (gad^.topEdge+gad^.height>win^.minHeight) THEN
win^.minHeight := gad^.topEdge+gad^.height+1;
END (* IF *);
END (* IF *);
END (* IF *);
gad := gad^.nextGadget;
UNTIL (gad=NIL);
RestoreCursor;
MouseOn;
END (* IF *);
END RedrawGadget;
PROCEDURE ShowGadget(gad : GadgetPtr);
VAR g : GadgetPtr;
win : WindowPtr;
BEGIN
win := tdos^.firstWindow;
IF (win^.firstGadget=NIL) THEN
win^.firstGadget := gad;
ELSE
g := win^.firstGadget;
WHILE (g^.nextGadget # NIL) DO
g := g^.nextGadget;
END (* WHILE *);
g^.nextGadget := gad;
END (* IF *);
RedrawGadget(gad);
END ShowGadget;
PROCEDURE ShowHelp(t1,t2 : STRING);
VAR i : CARDINAL;
BEGIN
DrawX(tdos^.colorHelpBar,0,tdos^.videoMaxY,tdos^.videoWidth-9,32);
IF (t2 # NIL) THEN
IF (t1 # NIL) THEN
i := Length(t1^);
WriteText(tdos^.colorHelpBar,0,tdos^.videoMaxY,t1);
IF NOT (Length(t2^)=0) THEN
DrawX(tdos^.colorHelpBar,i,tdos^.videoMaxY,1,58);
END (* IF *);
i := i + 2;
ELSE
i := 0;
END (* IF *);
WriteText(tdos^.colorHelpBar,i,tdos^.videoMaxY,t2);
END (* IF *);
RestoreCursor;
END ShowHelp;
PROCEDURE OpenMenu(menu : MenuPtr;
ptr : SysMsgPtr) : CARDINAL;
VAR res : CARDINAL;
i,j : CARDINAL;
PROCEDURE UnSelect;
BEGIN
IF NOT (j=0FFFFH) THEN
MouseOff;
DrawX(tdos^.colorMenuEnabled,menu^.itemLeftEdge+1,j+2,menu^.itemWidth-2,32);
WriteText(tdos^.colorMenuEnabled,menu^.itemLeftEdge+2,j+2,ADR(menu^.items[j]));
IF (checked IN menu^.flags[j]) THEN
DrawX(tdos^.colorMenuEnabled,menu^.itemLeftEdge+menu^.itemWidth-3,j+2,1,251);
END (* IF *);
ShowHelp(ADR(menu^.title),ADR(menu^.info));
MouseOn;
j := 0FFFFH;
END (* IF *);
END UnSelect;
BEGIN
res := 0;
MouseOff;
WriteText(tdos^.colorMenuSelected,menu^.leftEdge,0,ADR(menu^.title));
CopyVideo2Buffer(tdos^.buffer,menu^.itemLeftEdge,1,menu^.itemWidth,menu^.itemCount+1);
Fill(tdos^.colorMenuBar,menu^.itemLeftEdge,1,menu^.itemWidth,menu^.itemCount+1,32);
DrawX(tdos^.colorMenuBorder,menu^.itemLeftEdge,1,menu^.itemWidth-1,196);
DrawX(tdos^.colorMenuBorder,menu^.itemLeftEdge,menu^.itemCount+2,menu^.itemWidth-1,196);
DrawY(tdos^.colorMenuBorder,menu^.itemLeftEdge,1,menu^.itemCount+1,179);
DrawY(tdos^.colorMenuBorder,menu^.itemLeftEdge+menu^.itemWidth-1,1,menu^.itemCount+1,179);
DrawX(tdos^.colorMenuBorder,menu^.itemLeftEdge,1,1,218);
DrawX(tdos^.colorMenuBorder,menu^.itemLeftEdge+menu^.itemWidth-1,1,1,191);
DrawX(tdos^.colorMenuBorder,menu^.itemLeftEdge,menu^.itemCount+2,1,192);
DrawX(tdos^.colorMenuBorder,menu^.itemLeftEdge+menu^.itemWidth-1,menu^.itemCount+2,1,217);
FOR i := 0 TO menu^.itemCount-1 DO
IF NOT (menuBar IN menu^.flags[i]) THEN
IF NOT (disabled IN menu^.flags[i]) THEN
j := tdos^.colorMenuEnabled;
ELSE
j := tdos^.colorMenuDisabled;
END (* IF *);
WriteText(j,menu^.itemLeftEdge+2,i+2,ADR(menu^.items[i]));
IF (checked IN menu^.flags[i]) THEN
DrawX(j,menu^.itemLeftEdge+menu^.itemWidth-3,i+2,1,251);
END (* IF *);
ELSE
DrawX(tdos^.colorMenuBorder,menu^.itemLeftEdge,i+2,menu^.itemWidth-1,196);
DrawX(tdos^.colorMenuBorder,menu^.itemLeftEdge,i+2,1,195);
DrawX(tdos^.colorMenuBorder,menu^.itemLeftEdge+menu^.itemWidth-1,i+2,1,180);
END (* IF *);
END (* FOR *);
ShowHelp(ADR(menu^.title),ADR(menu^.info));
MouseOn;
j := 0FFFFH;
REPEAT
GetMouseData;
IF ((tdos^.mouseY>=2) AND (tdos^.mouseY<=menu^.itemCount+1)) THEN
IF ((tdos^.mouseX>=menu^.itemLeftEdge) AND (tdos^.mouseX<=(menu^.itemLeftEdge+menu^.itemWidth-1))) THEN
i := tdos^.mouseY-2;
IF NOT (i=j) THEN
IF NOT ((disabled IN menu^.flags[i]) OR (menuBar IN menu^.flags[i])) THEN
UnSelect;
MouseOff;
DrawX(tdos^.colorMenuSelected,menu^.itemLeftEdge+1,i+2,menu^.itemWidth-2,32);
WriteText(tdos^.colorMenuSelected,menu^.itemLeftEdge+2,i+2,ADR(menu^.items[i]));
ShowHelp(ADR(menu^.items[i]),ADR(menu^.help[i]));
IF (checked IN menu^.flags[i]) THEN
DrawX(tdos^.colorMenuSelected,menu^.itemLeftEdge+menu^.itemWidth-3,i+2,1,251);
END (* IF *);
MouseOn;
j := i;
ELSE
UnSelect;
END (* IF *);
END (* IF *);
ELSE
UnSelect;
END (* IF *);
ELSE
UnSelect;
IF (tdos^.mouseY<2) THEN
IF NOT ((tdos^.mouseX>=menu^.leftEdge) AND (tdos^.mouseX<=(menu^.leftEdge+Length(menu^.title)))) THEN
res := 1;
END (* IF *);
END (* IF *);
END (* IF *);
UNTIL NOT ((left IN tdos^.mouseButtons) AND (res=0));
MouseOff;
CopyBuffer2Video(tdos^.buffer,menu^.itemLeftEdge,1,menu^.itemWidth,menu^.itemCount+1);
WriteText(tdos^.colorMenuBar,menu^.leftEdge,0,ADR(menu^.title));
ShowHelp(NIL,NIL);
RestoreCursor;
MouseOn;
IF ((j<>0FFFFH) AND (res=0)) THEN
ptr^.itemNum := j;
res := 2;
IF (checkit IN menu^.flags[j]) THEN
IF (checked IN menu^.flags[j]) THEN
menu^.flags[j] := menu^.flags[j] - ItemFlagSet{checked};
ELSE
menu^.flags[j] := menu^.flags[j] + ItemFlagSet{checked};
END (* IF *);
END (* IF *);
END (* IF *);
RETURN(res);
END OpenMenu;
PROCEDURE GetChar(x,y : CARDINAL) : CARDINAL;
VAR c,seg,ofs : CARDINAL;
BEGIN
seg := 0B800H;
ofs := (y*tdos^.videoBPR)+(x*2);
ASM
MOV ES,seg
MOV DI,ofs
MOV AL,ES:[DI]
MOV AH,ES:[DI+1]
MOV c,AX
END (* ASM *);
RETURN(c);
END GetChar;
PROCEDURE PutChar(x,y,c : CARDINAL);
VAR seg,ofs : CARDINAL;
BEGIN
seg := 0B800H;
ofs := (y*tdos^.videoBPR)+(x*2);
ASM
MOV ES,seg
MOV DI,ofs
MOV AX,c
MOV ES:[DI],AL
MOV ES:[DI+1],AH
END (* ASM *);
END PutChar;
PROCEDURE SizeWindow(nw,nh : CARDINAL);
VAR win : WindowPtr;
BEGIN
win := tdos^.firstWindow;
IF NOT ((nw=win^.width) AND (nh=win^.height)) THEN
MouseOff;
Fill(tdos^.colorScreenBackgrnd,win^.leftEdge,win^.topEdge,win^.width,win^.height,tdos^.patternScreenBackgrnd);
win^.width := nw;
win^.height := nh;
Fill(tdos^.colorWindowBackgrnd,win^.leftEdge,win^.topEdge,win^.width,win^.height,tdos^.patternWindowBackgrnd);
DrawWindowBorder(win,TRUE);
win^.sysGadgets[1].leftEdge := win^.width-4;
win^.sysGadgets[2].leftEdge := win^.width-1;
win^.sysGadgets[2].topEdge := win^.height;
CopyVideo2Buffer(win^.buffer,win^.leftEdge,win^.topEdge,win^.width,win^.height);
RestoreWindows(win);
win^.cursorPos := 05050H;
tdos^.cursorPos := 05050H;
RedrawGadget(win^.firstGadget);
RestoreCursor;
MouseOn;
END (* IF *);
END SizeWindow;
PROCEDURE WinSize;
VAR win : WindowPtr;
bx,by,
ox,oy,
c1,c2,
c3,c4,
min : CARDINAL;
PROCEDURE RemIt;
BEGIN
IF NOT (ox=0FFFFH) THEN
PutChar(ox,oy,c1);
PutChar(win^.leftEdge,win^.topEdge,c2);
PutChar(ox,win^.topEdge,c3);
PutChar(win^.leftEdge,oy,c4);
END (* IF *);
END RemIt;
PROCEDURE DrawIt;
BEGIN
RemIt;
ox := bx;
oy := by;
c1 := GetChar(bx,by);
c2 := GetChar(win^.leftEdge,win^.topEdge);
c3 := GetChar(bx,win^.topEdge);
c4 := GetChar(win^.leftEdge,by);
DrawX(tdos^.colorMove,bx,by,1,29);
DrawX(tdos^.colorMove,win^.leftEdge,win^.topEdge,1,29);
DrawX(tdos^.colorMove,bx,win^.topEdge,1,29);
DrawX(tdos^.colorMove,win^.leftEdge,by,1,29);
END DrawIt;
BEGIN
win := tdos^.firstWindow;
IF (windowSizing IN win^.flags) THEN
bx := win^.leftEdge+win^.width-1;
by := win^.topEdge+win^.height;
ox := 0FFFFH;
oy := 0FFFFH;
min := Length(win^.title)+10;
MouseOff;
tdos^.help := "Ziehen Sie das Fenster mit der Maus auf die gewünschte Größe.";
ShowHelp(NIL,ADR(tdos^.help));
DrawIt;
REPEAT
GetMouseData;
bx := tdos^.mouseX;
by := tdos^.mouseY;
IF (bx<(win^.leftEdge+min)) THEN
bx := win^.leftEdge+min;
END (* IF *);
IF (by>(tdos^.videoMaxY-1)) THEN
by := tdos^.videoMaxY-1;
END (* IF *);
IF (by<win^.topEdge+1) THEN
by := win^.topEdge+1;
END (* IF *);
IF (bx<(win^.leftEdge+win^.minWidth)) THEN
bx := win^.leftEdge+win^.minWidth;
END (* IF *);
IF (by<(win^.topEdge+win^.minHeight)) THEN
by := win^.topEdge+win^.minHeight;
END (* IF *);
IF NOT ((ox=bx) AND (oy=by)) THEN
DrawIt;
END (* IF *);
UNTIL NOT (left IN tdos^.mouseButtons);
RemIt;
IF NOT (mid IN tdos^.mouseButtons) THEN
SizeWindow(bx-(win^.leftEdge-1),by-win^.topEdge);
ELSE
REPEAT
GetMouseData;
UNTIL NOT (mid IN tdos^.mouseButtons);
END (* IF *);
ShowHelp(NIL,NIL);
RestoreCursor;
MouseOn;
END (* IF *);
END WinSize;
PROCEDURE MoveWindow(x,y : CARDINAL);
VAR win : WindowPtr;
BEGIN
win := tdos^.firstWindow;
IF NOT ((x=win^.leftEdge) AND (y=win^.topEdge)) THEN
MouseOff;
CopyVideo2Buffer(win^.buffer,win^.leftEdge,win^.topEdge,win^.width,win^.height);
Fill(tdos^.colorScreenBackgrnd,win^.leftEdge,win^.topEdge,win^.width,win^.height,tdos^.patternScreenBackgrnd);
win^.leftEdge := x;
win^.topEdge := y+1;
RestoreWindows(win);
tdos^.cursorPos := win^.cursorPos+(win^.topEdge*256)+win^.leftEdge;
RestoreCursor;
MouseOn;
END (* IF *);
END MoveWindow;
PROCEDURE WinMove;
VAR win : WindowPtr;
bx,by,
ox,oy,
c1,c2,
c3,c4 : CARDINAL;
PROCEDURE RemIt;
BEGIN
IF NOT (ox=0FFFFH) THEN
PutChar(ox,oy,c1);
PutChar(ox+win^.width-1,oy,c2);
PutChar(ox+win^.width-1,oy+win^.height,c3);
PutChar(ox,oy+win^.height,c4);
END (* IF *);
END RemIt;
PROCEDURE DrawIt;
BEGIN
RemIt;
ox := bx;
oy := by;
c1 := GetChar(bx,by);
c2 := GetChar(bx+win^.width-1,by);
c3 := GetChar(bx+win^.width-1,by+win^.height);
c4 := GetChar(bx,by+win^.height);
DrawX(tdos^.colorMove,bx,by,1,17);
DrawX(tdos^.colorMove,bx+win^.width-1,by,1,16);
DrawX(tdos^.colorMove,bx+win^.width-1,by+win^.height,1,16);
DrawX(tdos^.colorMove,bx,by+win^.height,1,17);
END DrawIt;
BEGIN
win := tdos^.firstWindow;
MouseOff;
CopyVideo2Buffer(win^.buffer,win^.leftEdge,win^.topEdge,win^.width,win^.height);
tdos^.help := "Verschieben Sie das Fenster mit der Maus in die gewünschte Position.";
ShowHelp(NIL,ADR(tdos^.help));
bx := win^.leftEdge;
by := win^.topEdge;
ox := 0FFFFH;
oy := 0FFFFH;
AX := 4;
CX := win^.leftEdge * 8;
DX := win^.topEdge * 8;
Trap(033H);
DrawIt;
REPEAT
GetMouseData;
bx := tdos^.mouseX;
by := tdos^.mouseY;
IF (by<1) THEN
by := 1;
END (* IF *);
IF (by+win^.height)>(tdos^.videoMaxY-1) THEN
by := tdos^.videoMaxY-win^.height-1;
END (* IF *);
IF (bx+win^.width)>tdos^.videoWidth THEN
bx := tdos^.videoWidth-win^.width;
END (* IF *);
IF NOT ((ox=bx) AND (oy=by)) THEN
DrawIt;
END (* IF *);
UNTIL NOT (right IN tdos^.mouseButtons);
RemIt;
IF NOT (mid IN tdos^.mouseButtons) THEN
MoveWindow(bx,by-1);
ELSE
REPEAT
GetMouseData;
UNTIL NOT (mid IN tdos^.mouseButtons);
END (* IF *);
ShowHelp(NIL,NIL);
RestoreCursor;
MouseOn;
END WinMove;
PROCEDURE ShowClock;
VAR time : Time;
h,m,s : CARDINAL;
text : ARRAY [0..3] OF CHAR;
PROCEDURE Out(x,num : CARDINAL;
bool : BOOLEAN);
BEGIN
NumToString(num,10,text,1);
IF (Length(text)<2) THEN
DrawX(tdos^.colorHelpBar,tdos^.videoMaxX-x,tdos^.videoMaxY,1,48);
WriteText(tdos^.colorHelpBar,tdos^.videoMaxX-x+1,tdos^.videoMaxY,ADR(text));
ELSE
WriteText(tdos^.colorHelpBar,tdos^.videoMaxX-x,tdos^.videoMaxY,ADR(text));
END (* IF *);
IF (bool=TRUE) THEN
DrawX(tdos^.colorHelpBar,tdos^.videoMaxX-x+2,tdos^.videoMaxY,1,58);
END (* IF *);
END Out;
BEGIN
GetTime(time);
h := time.minute DIV 60;
m := time.minute MOD 60;
s := time.millisec DIV 1000;
Out(8,h,TRUE);
Out(5,m,TRUE);
Out(2,s,FALSE);
RestoreCursor;
END ShowClock;
PROCEDURE ModifyProp(gad : GadgetPtr;
pos,max : CARDINAL);
BEGIN
IF (pos>max) THEN pos := max; END;
gad^.propMax := max;
gad^.propPos := pos;
RedrawGadget(gad);
END ModifyProp;
PROCEDURE LineH(x,y,l : CARDINAL);
VAR win : WindowPtr;
c : CARDINAL;
BEGIN
win := tdos^.firstWindow;
x := x + win^.leftEdge;
y := y + win^.topEdge;
c := win^.frontPen+(win^.backPen*16);
MouseOff;
DrawX(c,x,y,1,195);
DrawX(c,x+1,y,l-2,196);
DrawX(c,x+l-1,y,1,180);
RestoreCursor;
MouseOn;
END LineH;
PROCEDURE LineV(x,y,l : CARDINAL);
VAR win : WindowPtr;
c : CARDINAL;
BEGIN
win := tdos^.firstWindow;
x := x + win^.leftEdge;
y := y + win^.topEdge;
c := win^.frontPen+(win^.backPen*16);
MouseOff;
DrawX(c,x,y,1,195);
DrawY(c,x,y+1,l-2,196);
DrawX(c,x,y+l-1,1,180);
RestoreCursor;
MouseOn;
END LineV;
PROCEDURE Char(x,y,c : CARDINAL);
VAR win : WindowPtr;
BEGIN
win := tdos^.firstWindow;
MouseOff;
DrawX(win^.frontPen+(win^.backPen*16),x+win^.leftEdge,y+win^.topEdge,1,c);
RestoreCursor;
MouseOn;
END Char;
PROCEDURE Box(x,y,w,h : CARDINAL);
VAR win : WindowPtr;
c : CARDINAL;
BEGIN
win := tdos^.firstWindow;
x := x + win^.leftEdge;
y := y + win^.topEdge;
c := win^.frontPen+(win^.backPen*16);
MouseOff;
DrawX(c,x+1,y,w-1,196);
DrawX(c,x+1,y+h-1,w-2,196);
DrawY(c,x,y+1,h-2,179);
DrawY(c,x+w-1,y+1,h-2,179);
DrawX(c,x,y,1,218);
DrawX(c,x+w-1,y,1,191);
DrawX(c,x+w-1,y+h-1,1,217);
DrawX(c,x,y+h-1,1,192);
RestoreCursor;
MouseOn;
END Box;
PROCEDURE DrawProp(gad : GadgetPtr; farbe : CARDINAL);
VAR win : WindowPtr;
x,y : CARDINAL;
old : CARDINAL;
BEGIN
win := tdos^.firstWindow;
x := win^.leftEdge+gad^.leftEdge;
y := win^.topEdge+gad^.topEdge;
old := gad^.propButton;
IF (gad^.propV=TRUE) THEN
gad^.propAdd := gad^.propMax DIV (gad^.height-3);
gad^.propButton := gad^.propPos DIV gad^.propAdd;
IF (gad^.propButton>(gad^.height-3)) THEN
gad^.propButton := gad^.height - 3;
END (* IF *);
IF NOT (old=gad^.propButton) THEN
MouseOff;
DrawX(farbe,x,y,1,24);
DrawY(farbe,x,y+1,gad^.height-3,176);
DrawX(farbe,x,y+gad^.height-1,1,25);
DrawX(15,x,y+1+gad^.propButton,1,219);
MouseOn;
RestoreCursor;
END (* IF *);
ELSE
gad^.propAdd := gad^.propMax DIV (gad^.width-3);
gad^.propButton := gad^.propPos DIV gad^.propAdd;
IF (gad^.propButton>(gad^.width-3)) THEN
gad^.propButton := gad^.width - 3;
END (* IF *);
IF NOT (old=gad^.propButton) THEN
MouseOff;
DrawX(farbe,x,y,1,27);
DrawX(farbe,x+1,y,gad^.width-2,176);
DrawX(farbe,x+gad^.width-1,y,1,26);
DrawX(15,x+1+gad^.propButton,y,1,219);
MouseOn;
RestoreCursor;
END (* IF *);
END (* IF *);
END DrawProp;
PROCEDURE PropGadgetHandler(gad : GadgetPtr;
ptr : SysMsgPtr);
VAR win : WindowPtr;
x,y : CARDINAL;
BEGIN
win := tdos^.firstWindow;
x := win^.leftEdge+gad^.leftEdge;
y := win^.topEdge+gad^.topEdge;
IF (gad^.propV=TRUE) THEN
IF (tdos^.mouseY=(y+gad^.height-1)) THEN
IF (gad^.propPos<gad^.propMax) THEN
gad^.propPos := gad^.propPos + 1;
END (* IF *);
ELSIF (tdos^.mouseY=y) THEN
IF (gad^.propPos>0) THEN
gad^.propPos := gad^.propPos - 1;
END (* IF *);
ELSIF (tdos^.mouseY=(y+1+gad^.propButton)) THEN
REPEAT
GetMouseData;
IF (tdos^.mouseY<=y) THEN
gad^.propPos := 0;
ELSIF (tdos^.mouseY>(y+gad^.height)) THEN
gad^.propPos := gad^.propMax;
ELSE
gad^.propPos := (tdos^.mouseY-y-1)*gad^.propAdd;
END (* IF *);
DrawProp(gad,colorGadget);
UNTIL NOT (left IN tdos^.mouseButtons);
ELSE
gad^.propPos := (tdos^.mouseY-y-1)*gad^.propAdd;
END (* IF *);
ELSE
IF (tdos^.mouseX=x+gad^.width-1) THEN
IF (gad^.propPos<gad^.propMax) THEN
gad^.propPos := gad^.propPos + 1;
END (* IF *);
ELSIF (tdos^.mouseX=x) THEN
IF (gad^.propPos>0) THEN
gad^.propPos := gad^.propPos - 1;
END (* IF *);
ELSIF (tdos^.mouseX=(x+1+gad^.propButton)) THEN
REPEAT
GetMouseData;
IF (tdos^.mouseX<=x) THEN
gad^.propPos := 0;
ELSIF (tdos^.mouseX>(x+gad^.width)) THEN
gad^.propPos := gad^.propMax;
ELSE
gad^.propPos := (tdos^.mouseX-x-1)*gad^.propAdd;
END (* IF *);
DrawProp(gad,colorGadget);
UNTIL NOT (left IN tdos^.mouseButtons);
ELSE
gad^.propPos := (tdos^.mouseX-x-1)*gad^.propAdd;
END (* IF *);
END (* IF *);
MouseOff;
DrawProp(gad,colorGadget);
MouseOn;
RestoreCursor;
END PropGadgetHandler;
PROCEDURE SystemManager;
VAR ptr : SysMsgPtr;
win,w2 : WindowPtr;
gad,g2 : GadgetPtr;
menu : MenuPtr;
i,j,k : CARDINAL;
ok : BOOLEAN;
bool : BOOLEAN;
BEGIN
ok := FALSE;
REPEAT
ptr := ADR(tdos^.message);
REPEAT
IF (timerUpdate=TRUE) THEN
timerUpdate := FALSE;
ShowClock;
END (* IF *);
GetMouseData;
AX := 0100H;
Trap(016H);
UNTIL ((left IN tdos^.mouseButtons) OR (right IN tdos^.mouseButtons) OR (mid IN tdos^.mouseButtons) OR (NOT (zeroFlag IN FLAGS)));
IF NOT (zeroFlag IN FLAGS) THEN
AX := 0;
Trap(016H);
i := AX;
IF (tdos^.firstWindow # NIL) THEN
ok := TRUE;
ptr^.window := tdos^.firstWindow;
ptr^.code := (i MOD 256);
ptr^.scancode := (i DIV 256);
ptr^.class := SysMsgClassSet{keyboard};
END (* IF *);
ELSE
win := tdos^.firstWindow;
IF (win # NIL) THEN
bool := FALSE;
w2 := NIL;
REPEAT
IF (tdos^.mouseX>=win^.leftEdge) THEN
IF (tdos^.mouseY>=win^.topEdge) THEN
IF (tdos^.mouseX<=(win^.leftEdge+win^.width-1)) THEN
IF (tdos^.mouseY<=(win^.topEdge+win^.height)) THEN
w2 := win;
bool := TRUE;
END (* IF *);
END (* IF *);
END (* IF *);
END (* IF *);
IF (bool=FALSE) THEN
win := win^.nextWindow;
IF (win=NIL) THEN
bool := TRUE;
END (* IF *);
END (* IF *);
UNTIL (bool=TRUE);
IF (left IN tdos^.mouseButtons) THEN
IF (w2 # NIL) THEN
win := w2;
ptr^.window := win;
IF NOT (win=tdos^.firstWindow) THEN
REPEAT
GetMouseData;
UNTIL NOT (left IN tdos^.mouseButtons);
IF (tdos^.mouseX>=win^.leftEdge) THEN
IF (tdos^.mouseY>=win^.topEdge) THEN
IF (tdos^.mouseX<=(win^.leftEdge+win^.width-1)) THEN
IF (tdos^.mouseY<=(win^.topEdge+win^.height)) THEN
ok := TRUE;
ptr^.class := SysMsgClassSet{activateWindow};
ActivateWindow(win);
END (* IF *);
END (* IF *);
END (* IF *);
END (* IF *);
ELSE
gad := win^.firstGadget;
g2 := NIL;
WHILE (gad # NIL) DO
IF (tdos^.mouseX>=(win^.leftEdge+gad^.leftEdge)) THEN
IF (tdos^.mouseY>=(win^.topEdge+gad^.topEdge)) THEN
IF (tdos^.mouseX<=(win^.leftEdge+gad^.leftEdge+gad^.width)) THEN
IF (tdos^.mouseY<(win^.topEdge+gad^.topEdge+gad^.height)) THEN
IF (gad^.enabled=TRUE) THEN
g2 := gad;
gad := NIL;
END (* IF *);
END (* IF *);
END (* IF *);
END (* IF *);
END (* IF *);
IF (gad # NIL) THEN gad := gad^.nextGadget; END;
END (* WHILE *);
IF (g2 # NIL) THEN
IF (g2^.type=sizeGadget) THEN
ok := TRUE;
ptr^.class := SysMsgClassSet{sizeWindow};
ShowHelp(NIL,ADR(g2^.help));
WinSize;
ELSIF (g2^.type=propGadget) THEN
PropGadgetHandler(g2,ptr);
ELSE
MouseOff;
WriteText(tdos^.colorGadgetSelected,win^.leftEdge+g2^.leftEdge,win^.topEdge+g2^.topEdge,ADR(g2^.text));
MouseOn;
ShowHelp(NIL,ADR(g2^.help));
REPEAT
GetMouseData;
UNTIL NOT (left IN tdos^.mouseButtons);
MouseOff;
WriteText(tdos^.colorGadget,win^.leftEdge+g2^.leftEdge,win^.topEdge+g2^.topEdge,ADR(g2^.text));
MouseOn;
IF (tdos^.mouseX>=(win^.leftEdge+g2^.leftEdge)) THEN
IF (tdos^.mouseY>=(win^.topEdge+g2^.topEdge)) THEN
IF (tdos^.mouseX<=(win^.leftEdge+g2^.leftEdge+g2^.width)) THEN
IF (tdos^.mouseY<(win^.topEdge+g2^.topEdge+g2^.height)) THEN
ok := TRUE;
CASE g2^.type OF
boolGadget:
ptr^.gadget := g2;
ptr^.gadgetID := g2^.id;
ptr^.class := SysMsgClassSet{gadgetUp};|
toggleGadget:
ptr^.gadget := g2;
ptr^.gadgetID := g2^.id;
ptr^.class := SysMsgClassSet{gadgetUp};
IF (g2^.selected=TRUE) THEN
g2^.text := "[ ]";
g2^.selected := FALSE;
ELSE
g2^.text := "[x]";
g2^.selected := TRUE;
END (* IF *);
MouseOff;
WriteText(tdos^.colorGadget,win^.leftEdge+g2^.leftEdge,win^.topEdge+g2^.topEdge,ADR(g2^.text));
MouseOn;|
strGadget:
ptr^.gadget := g2;
ptr^.gadgetID := g2^.id;
ptr^.class := SysMsgClassSet{gadgetUp};
StrGadgetHandler(g2);|
closeGadget:
ptr^.class := SysMsgClassSet{closeWindow};|
depthGadget:
IF (win^.nextWindow # NIL) THEN
w2 := win;
WHILE (w2^.nextWindow # NIL) DO
w2 := w2^.nextWindow;
END (* WHILE *);
ptr^.class := SysMsgClassSet{activateWindow};
ptr^.window := w2;
ActivateWindow(w2);
ELSE
ok := FALSE;
END (* IF *);
END (* CASE *);
END (* IF *);
END (* IF *);
END (* IF *);
END (* IF *);
ShowHelp(NIL,NIL);
END (* IF *);
END (* IF *);
END (* IF *);
ELSE
REPEAT
GetMouseData;
k := 0;
IF ((left IN tdos^.mouseButtons) AND (tdos^.mouseY=0)) THEN
win := tdos^.firstWindow;
menu := win^.firstMenu;
bool := FALSE;
i := 0;
WHILE ((menu # NIL) AND (bool=FALSE)) DO
IF ((tdos^.mouseX>=menu^.leftEdge) AND (tdos^.mouseX<=(menu^.leftEdge+Length(menu^.title)))) THEN
bool := TRUE;
ELSE
menu := menu^.nextMenu;
i := i + 1;
END (* IF *);
END (* WHILE *);
IF (bool=TRUE) THEN
ptr^.class := SysMsgClassSet{menuPick};
ptr^.menuNum := i;
k := OpenMenu(menu,ptr);
IF (k=2) THEN
ok := TRUE;
END (* IF *);
END (* IF *);
END (* IF *);
UNTIL NOT ((k=1) OR (left IN tdos^.mouseButtons));
END (* IF *);
ELSIF (right IN tdos^.mouseButtons) THEN
win := tdos^.firstWindow;
IF (windowDrag IN win^.flags) THEN
IF NOT (requester IN win^.flags) THEN
ptr^.window := win;
ptr^.class := SysMsgClassSet{moveWindow};
WinMove;
END (* IF *);
END (* IF *);
ELSIF (mid IN tdos^.mouseButtons) THEN
win := tdos^.firstWindow;
IF (((windowSizing IN win^.flags) AND (windowDrag IN win^.flags)) AND NOT (requester IN win^.flags)) THEN
IF NOT ((win^.leftEdge=0) AND (win^.topEdge=1) AND (win^.width=tdos^.videoWidth) AND (win^.height=tdos^.videoMaxY-2) AND (win^.maxWindow=FALSE)) THEN
win := tdos^.firstWindow;
ptr^.window := win;
ptr^.class := SysMsgClassSet{moveWindow,sizeWindow};
IF (win^.maxWindow=FALSE) THEN
win^.maxWindow := TRUE;
win^.maxW := win^.width;
win^.maxH := win^.height;
win^.maxX := win^.leftEdge;
win^.maxY := win^.topEdge-1;
MoveWindow(0,0);
SizeWindow(tdos^.videoWidth,tdos^.videoMaxY-2);
ELSE
win^.maxWindow := FALSE;
SizeWindow(win^.maxW,win^.maxH);
MoveWindow(win^.maxX,win^.maxY);
END (* IF *);
REPEAT
GetMouseData;
UNTIL NOT (mid IN tdos^.mouseButtons);
END (* IF *);
END (* IF *);
END (* IF *);
ELSE
ok := TRUE;
ptr^.class := SysMsgClassSet{noWindow};
END (* IF *);
END (* IF *);
UNTIL (ok=TRUE);
END SystemManager;
PROCEDURE WaitForKey;
BEGIN
AX := 0;
Trap(016H);
END WaitForKey;
PROCEDURE OpenScreen(new : BOOLEAN);
BEGIN
IF (new=TRUE) THEN
tdos^.cursorPos := 05050H;
tdos^.firstWindow := NIL;
tdos^.mouseLock := 0;
tdos^.videoBPR := tdos^.videoWidth*2;
tdos^.videoMaxX := tdos^.videoWidth-1;
tdos^.videoMaxY := tdos^.videoHeight-1;
tdos^.videoSize := (tdos^.videoBPR*tdos^.videoHeight);
END (* IF *);
AX := tdos^.videoMode;
Trap(010H);
MouseReset;
MouseLimits(0,0,tdos^.videoMaxX,tdos^.videoMaxY-1);
Fill(tdos^.colorScreenBackgrnd,0,1,tdos^.videoWidth,tdos^.videoHeight-2,tdos^.patternScreenBackgrnd);
DrawX(tdos^.colorMenuBar,0,0,tdos^.videoWidth,32);
DrawX(tdos^.colorHelpBar,0,tdos^.videoMaxY,tdos^.videoWidth,32);
IF (new=TRUE) THEN
tdos^.help := welcome;
ShowHelp(NIL,ADR(tdos^.help));
END (* IF *);
IF (tdos^.firstWindow # NIL) THEN
ShowMenuStrip(tdos^.firstWindow);
END (* IF *);
ShowClock;
MouseOn;
tdos^.active := TRUE;
END OpenScreen;
PROCEDURE CloseScreen;
BEGIN
MouseOff;
AX := 3;
Trap(010H);
tdos^.active := FALSE;
END CloseScreen;
PROCEDURE GraphicsLibrary(cmd : CARDINAL;
a,b,c,d,e : CARDINAL;
seg,ofs : CARDINAL);
VAR ptr : ADDRESS;
BEGIN
ptr.SEG := seg;
ptr.OFS := ofs;
MouseOff;
CASE cmd OF
0:
WriteText(a,b,c,ptr);|
1:
Fill(a,b,c,d,e,ofs);|
2:
SetCursor(a,b);|
3:
RestoreCursor;|
4:
CopyVideo2Buffer(ptr,a,b,c,d);|
5:
CopyBuffer2Video(ptr,a,b,c,d);|
6:
DrawX(a,b,c,d,e);|
7:
DrawY(a,b,c,d,e);
END (* CASE *);
MouseOn;
END GraphicsLibrary;
PROCEDURE MouseLibrary(cmd : CARDINAL;
seg,ofs : CARDINAL);
VAR x,y : CARDINAL;
b : MouseButtonSet;
BEGIN
CASE cmd OF
0:
MouseReset;|
1:
MouseOn;|
2:
MouseOff;|
3:
GetMouseData;
END (* CASE *);
END MouseLibrary;
PROCEDURE DisplayLibrary(cmd : CARDINAL;
a,b,c : CARDINAL;
seg,ofs : CARDINAL);
VAR adr,ptr : ADDRESS;
BEGIN
adr.SEG := seg;
adr.OFS := ofs;
ptr.SEG := a;
ptr.OFS := b;
CASE cmd OF
0:
OpenScreen(TRUE);|
1:
CloseScreen;|
2:
OpenWindow(adr);|
3:
SetAPen(a);|
4:
SetBPen(a);|
5:
xMove(a,b);|
6:
Text(adr);|
7:
ShowMenu(adr);|
8:
ShowHelp(adr,ptr);|
9:
ShowGadget(adr);|
10:
MoveWindow(a,b);|
11:
SizeWindow(a,b);|
12:
CloseWindow;|
13:
CenterText(a,adr);|
14:
IF (tdos^.firstWindow^.firstGadget # NIL) THEN
RedrawGadget(tdos^.firstWindow^.firstGadget);
END (* IF *);|
(*
15:
ModifyProp(adr,a,b);|
16:
LineH(a,b,c);|
17:
LineV(a,b,c);|
18:
Char(a,b,c);|
19:
Box(a,b,c,seg);| *)
0FFH:
SystemManager;
END (* CASE *);
END DisplayLibrary;
PROCEDURE SpecialLibrary(cmd : CARDINAL);
VAR win : WindowPtr;
BEGIN
CASE cmd OF
0:
MouseOff;
win := tdos^.firstWindow;
IF (win # NIL) THEN
CopyVideo2Buffer(win^.buffer,win^.leftEdge,win^.topEdge,win^.width,win^.height);
END (* IF *);
MouseOn;
CloseScreen;|
1:
OpenScreen(FALSE);
MouseOff;
IF (tdos^.firstWindow # NIL) THEN
RestoreWindows(tdos^.firstWindow);
END (* IF *);
MouseOn;
END (* CASE *);
END SpecialLibrary;
PROCEDURE TurboDOSInterrupt;
BEGIN
ASM
x00: (* 00: GraphicsLibrary(AL,BX,CX,DX,DS,SI,ES,DI) *)
CMP AH,0
JNE x01
XOR AH,AH
PUSH AX
PUSH BX
PUSH CX
PUSH DX
PUSH DS
PUSH SI
PUSH ES
PUSH DI
CALL GraphicsLibrary
IRET
x01:
CMP AH,1 (* 01: MouseLibrary(AL,ES,DI) *)
JNE x02
XOR AH,AH
PUSH AX
PUSH ES
PUSH DI
CALL MouseLibrary
IRET
x02:
CMP AH,2 (* 02: DisplayLibrary(AL,BX,CX,DX,ES,DI) *)
JNE x03
XOR AH,AH
PUSH AX
PUSH BX
PUSH CX
PUSH DX
PUSH ES
PUSH DI
CALL DisplayLibrary
IRET
x03:
CMP AH,3
JNE x04
XOR AH,AH
PUSH AX
CALL SpecialLibrary
IRET
x04:
IRET
END (* ASM *);
END TurboDOSInterrupt;
(* ------ TurboDOS - Hauptprogramm ----------- *)
PROCEDURE InstallTurboDOS;
VAR o,s,tasten : CARDINAL;
BEGIN
AX := 0;
Trap(033H);
IF (AX=0) THEN
Crash(noMouse);
END (* IF *);
tasten := BX;
ALLOCATE(tdos,SIZE(TurboDOS));
IF (tdos=NIL) THEN
Crash(noMemory);
END (* IF *);
ALLOCATE(tdos^.buffer,videoWidth*videoHeight*2);
IF (tdos^.buffer=NIL) THEN
Crash(noMemory);
END (* IF *);
o := OFFSET(oldColors);
s := SEGMENT(oldColors);
ASM
MOV AX,01017H
MOV BX,0
MOV CX,16
MOV ES,s
MOV DX,o
INT 010H
END (* ASM *);
tdos^.videoWidth := videoWidth;
tdos^.videoHeight := videoHeight;
tdos^.videoMode := videoMode;
tdos^.version := version;
tdos^.buttonCount := tasten;
tdos^.id[0] := "T";
tdos^.id[1] := "D";
tdos^.id[2] := "O";
tdos^.id[3] := "S";
tdos^.patternScreenBackgrnd := patternScreenBackgrnd;
tdos^.patternWindowBackgrnd := patternWindowBackgrnd;
tdos^.colorScreenBackgrnd := colorScreenBackgrnd;
tdos^.colorHelpBar := colorHelpBar;
tdos^.colorMove := colorMove;
tdos^.colorWindowBackgrnd := colorWindowBackgrnd;
tdos^.colorAWindowBorders := colorAWindowBorders;
tdos^.colorIWindowBorders := colorIWindowBorders;
tdos^.colorWindowAPen := colorWindowAPen;
tdos^.colorWindowBPen := colorWindowBPen;
tdos^.colorGadget := colorGadget;
tdos^.colorGadgetSelected := colorGadgetSelected;
tdos^.colorGadgetDisabled := colorGadgetDisabled;
tdos^.colorMenuBar := colorMenuBar;
tdos^.colorMenuEnabled := colorMenuEnabled;
tdos^.colorMenuDisabled := colorMenuDisabled;
tdos^.colorMenuSelected := colorMenuSelected;
tdos^.colorMenuBorder := colorMenuBorder;
timerCounter := 0;
timerUpdate := TRUE;
GetVector(memoryVector,oldVector1);
GetVector(interruptVector,oldVector2);
GetVector(timerVector,oldVector3);
ResetVector(memoryVector,tdos);
SetVector(interruptVector,TurboDOSInterrupt);
TurboSys.OpenScreen;
SetVector(timerVector,TimerInterrupt);
END InstallTurboDOS;
PROCEDURE RemoveTurboDOS;
VAR o,s : CARDINAL;
BEGIN
TurboSys.CloseScreen;
o := OFFSET(oldColors) ;
s := SEGMENT(oldColors);
ASM
MOV AX,01012H
MOV BX,0
MOV CX,16
MOV ES,s
MOV DX,o
INT 010H
END (* ASM *);
ResetVector(timerVector,oldVector3);
ResetVector(memoryVector,oldVector1);
ResetVector(interruptVector,oldVector2);
DEALLOCATE(tdos^.buffer,tdos^.videoSize);
DEALLOCATE(tdos,SIZE(TurboDOS));
END RemoveTurboDOS;
PROCEDURE Crash(error : CARDINAL);
BEGIN
AX := 3;
Trap(010H);
CASE error OF
noMouse:
WriteString("TurboDOS benötigt eine Maus!");|
noMemory:
WriteString("Nicht genug freier Speicher!");
END (* CASE *);
WriteLn;
WriteLn;
Terminate(0);
END Crash;
PROCEDURE Break;
BEGIN
RemoveTurboDOS;
Terminate(0);
END Break;
BEGIN
IF (tdos=NIL) THEN
InstallTurboDOS;
(*
a := TurboSys.ExecuteApplication("test.exe","/1",FALSE);
a := TurboSys.ExecuteApplication("c:\dos\command.com","",TRUE);
*)
t1 := " Fenster #1 ";
t2 := " Fenster #2 ";
t3 := " Fenster #3 ";
w1 := TurboSys.OpenWindow(" Fenster #1 ",7,1,550,700,
WindowFlagSet{windowClose,windowDrag,windowSizing,windowDepth},10,3);
w2 := TurboSys.OpenWindow(" Fenster #2 ",10,3,55,7,
WindowFlagSet{windowClose,windowDrag,windowSizing,windowDepth},10,3);
w4 := TurboSys.OpenWindow(" Fenster #3 ",13,5,55,7,
WindowFlagSet{windowClose,windowDrag,windowSizing,windowDepth},10,3);
w5 := TurboSys.OpenWindow(" Fenster #4 ",16,7,55,7,
WindowFlagSet{windowClose,windowDrag,windowSizing,windowDepth},10,3);
w3 := TurboSys.OpenWindow(" Fenster #5 ",19,8,55,13,
WindowFlagSet{windowClose,windowDrag,windowSizing,windowDepth},10,3);
m2.nextMenu := NIL;
m2.title := "Test-Menü";
m2.leftEdge := 20;
m2.itemLeftEdge := 19;
m2.itemWidth := 25;
m2.itemCount := 3;
m2.items[0] := "Item Nummer 1";
m2.flags[0] := check;
m2.items[1] := "Item Nummer 2";
m2.flags[1] := check;
m2.items[2] := "Item Nummer 3";
m2.flags[2] := check;
m1.nextMenu := ADR(m2);
m1.title := "Projekt";
m1.info := "Hier können Dateioperationen ausgeführt werden.";
m1.leftEdge := 2;
m1.itemLeftEdge := 1;
m1.itemWidth := 25;
m1.itemCount := 7;
m1.items[0] := "Neu";
m1.flags[0] := stdItem;
m1.help[0] := "Es wird ein neues Projekt angelegt...";
m1.items[1] := "";
m1.flags[1] := bar;
m1.items[2] := "Laden";
m1.flags[2] := stdItem;
m1.help[2] := "Ein altes Projekt wird geladen...";
m1.items[3] := "Sichern";
m1.flags[3] := ItemFlagSet{disabled};
m1.items[4] := "Sichern als";
m1.flags[4] := stdItem;
m1.help[4] := "Das aktuelle Projekt wird unter neuem Namen gesichert...";
m1.items[5] := "";
m1.flags[5] := bar;
m1.items[6] := "Programmende";
m1.flags[6] := stdItem;
m1.help[6] := "Das Programm wird beendet...";
TurboSys.ShowMenu(ADR(m1));
g7.nextGadget := NIL;
g7.leftEdge := 30;
g7.topEdge := 2;
g7.width := 1;
g7.height := 10;
g7.type := propGadget;
g7.id := 106;
g7.enabled := TRUE;
g7.propV := TRUE;
g7.propMax := 400;
g7.propPos := 0;
g6.nextGadget := ADR(g7);
g6.leftEdge := 2;
g6.topEdge := 11;
g6.width := 10;
g6.height := 1;
g6.type := propGadget;
g6.id := 105;
g6.enabled := TRUE;
g6.propV := FALSE;
g6.propMax := 400;
g6.propPos := 0;
g5.nextGadget := ADR(g6);
g5.leftEdge := 2;
g5.topEdge := 10;
g5.width := 3;
g5.height := 1;
g5.type := toggleGadget;
g5.id := 104;
g5.enabled := TRUE;
g5.help := "Toggle-Select-Gadget";
g4.nextGadget := ADR(g5);
g4.leftEdge := 2;
g4.topEdge := 9;
g4.width := 20;
g4.height := 1;
g4.type := strGadget;
g4.id := 103;
g4.enabled := TRUE;
g4.help := "Geben Sie einen String ein!";
ALLOCATE(g4.buffer,100);
t3 := "String-Gadget";
Assign(t3,g4.buffer^);
g3.nextGadget := ADR(g4);
g3.leftEdge := 2;
g3.topEdge := 7;
g3.width := 0;
g3.height := 1;
g3.text := "<Gadget #2>";
g3.type := boolGadget;
g3.id := 102;
g3.enabled := FALSE;
g2.nextGadget := ADR(g3);
g2.leftEdge := 2;
g2.topEdge := 5;
g2.width := 0;
g2.height := 1;
g2.text := "<COMMAND.COM>";
g2.type := boolGadget;
g2.id := 101;
g2.enabled := TRUE;
g2.help := "Aufruf des Kommandointerpreters...";
g1.nextGadget := ADR(g2);
g1.leftEdge := 2;
g1.topEdge := 3;
g1.width := 0;
g1.height := 1;
g1.text := "<Gadget #1>";
g1.type := boolGadget;
g1.id := 100;
g1.enabled := TRUE;
g1.help := "Dies ist Gadget 1";
TurboSys.ShowGadget(ADR(g1));
TurboSys.Move(15,6);
TurboSys.SetAPen(9);
TurboSys.SetBPen(3);
TurboSys.Text("TurboDOS ");
TurboSys.Text("Version 1.0");
(*
w6 := TurboSys.OpenWindow(" System Request ",15,10,50,8,
WindowFlagSet{windowClose,requester},10,3);
TurboSys.CenterText(3,"SYSTEM-REQUESTER");
TurboSys.CenterText(5,"Dies ist ein System-Requester!");
TurboSys.CenterText(6,"Klicken Sie auf das Schließgadget, um");
TurboSys.CenterText(7,"den Requester zu schließen.");
*)
InstallBreakHandler(Break);
EnableBreak;
(*
REPEAT
TurboSys.SystemManager;
UNTIL (tdos^.message.class=SysMsgClassSet{closeWindow});
TurboSys.CloseWindow;
*)
w6 := NIL;
REPEAT
TurboSys.SystemManager;
IF (closeWindow IN tdos^.message.class) THEN
w6 := tdos^.message.window;
IF (w6=w1) THEN TurboSys.CloseWindow; w1 := NIL; END;
IF (w6=w2) THEN TurboSys.CloseWindow; w2 := NIL; END;
IF (w6=w4) THEN TurboSys.CloseWindow; w4 := NIL; END;
IF (w6=w5) THEN TurboSys.CloseWindow; w5 := NIL; END;
ELSIF (gadgetUp IN tdos^.message.class) THEN
IF (tdos^.message.gadgetID=101) THEN
a := TurboSys.ExecuteApplication("c:\dos\command.com","",TRUE);
END (* IF *);
END (* IF *);
UNTIL (w6=w3);
UninstallBreakHandler;
RemoveTurboDOS;
ELSE
WriteString("TurboDOS wurde bereits gestartet!");
WriteLn;
END (* IF *);
END Turbo.